home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / win / vb / comserv.exe / COMSERVE.BAS < prev    next >
Encoding:
BASIC Source File  |  1992-03-13  |  3.7 KB  |  142 lines
  1. 'This is the module for the CompuServe zip file application.
  2.  
  3. Dim mFileLen As Long
  4.  
  5. Sub Startup ()
  6.  
  7.     gsFName = "ComServe.dat"        'File name.
  8.     giFileLen = Len(gComServeRec)   'Record length.
  9.  
  10.     OpenFile
  11.     SizeOfFile& = LOF(giFileNo)
  12.     Close giFileNo
  13.     giNoOfRecs = SizeOfFile& / giFileLen
  14.     ReDim gSortData(giNoOfRecs)
  15.  
  16. End Sub
  17.  
  18. Sub SaveRec ()
  19.  
  20.     OpenFile
  21.  
  22.     If (gAddRec) Then   'Add a new record to the end of the file.
  23.         'Calculate the number of records currently.
  24.  
  25.         mFileLen = LOF(giFileNo)
  26.         giNoOfRecs = (mFileLen / Len(gComServeRec)) + 1
  27.         gComServeRec.RecNo = giNoOfRecs
  28.  
  29.         giIndex = giNoOfRecs
  30.  
  31.     End If
  32.  
  33.     Put giFileNo, giIndex, gComServeRec
  34.  
  35.     Close giFileNo
  36.  
  37.     If (gModRec) Then   'Return to the list.
  38.         Load ComSList
  39.         ComSList.Show
  40.         Unload OneRec
  41.     End If
  42.  
  43.     
  44.  
  45. End Sub
  46.  
  47. Sub OpenFile ()
  48.     'Opens the file.
  49.     
  50.     giFileNo = FreeFile     'Get a file number.
  51.  
  52.     Open gsFName For Random As giFileNo Len = giFileLen
  53.     
  54. End Sub
  55.  
  56. Function IsPrint (TheChar As String) As Integer
  57.     'Checks to see if the char is printable.
  58.  
  59.     AsciiVal% = Asc(TheChar)
  60.  
  61.     If ((AsciiVal% > 32) And (AsciiVal% < 127)) Then
  62.         IsPrint = True
  63.     Else
  64.         IsPrint = False
  65.     End If
  66.  
  67. End Function
  68.  
  69. Function StringMatch (sSearch As String, sFind As String) As Integer
  70.     'Used in the search routines.
  71.     'This matches any occurance to the find string in the search string.
  72.     'You need to add code to match whole words only.
  73.  
  74.     result% = InStr(sSearch, sFind)
  75.  
  76.     If (result% > 0) Then
  77.         StringMatch = True
  78.     Else
  79.         StringMatch = False
  80.     End If
  81.  
  82. End Function
  83.  
  84. Function GetFileName (sSearch As String) As String
  85.     'Parse out the file name from the string.
  86.     'If not found return the empty string.
  87.  
  88.     iPosition& = InStr(sSearch, ".")    'Remember the file names need the extension.
  89.     If iPosition& > 0 Then
  90.         GetFileName = Left$(sSearch, iPosition& + 3) + Chr$(0)
  91.     Else
  92.         GetFileName = "" + Chr$(0)
  93.     End If
  94.  
  95. End Function
  96.  
  97. Sub BuildFileKey ()
  98.     'This subroutine builds the sort data structure.
  99.  
  100.     gSortData(glArrayIndex).RecNo = gComServeRec.RecNo
  101.     gSortData(glArrayIndex).FileName = gComServeRec.FileName
  102.     gSortData(glArrayIndex).CompuServeID = gComServeRec.CompuServeID
  103.     gSortData(glArrayIndex).Author = gComServeRec.Author
  104.     gSortData(glArrayIndex).Company = gComServeRec.Company
  105.     gSortData(glArrayIndex).Title = gComServeRec.Title
  106.     glArrayIndex = glArrayIndex + 1
  107.  
  108. End Sub
  109.  
  110. Function GetFileIndex (sFileName As String) As Long
  111.     'This function returns the record index for loading from the file.
  112.     'Returns 0 if it is not found.
  113.  
  114.     i% = 0
  115.     sFileName = LTrim$(RTrim$(sFileName))   'Get rid of extra spaces.
  116.  
  117.     'Search the sort data structure arrays for a matching file name.
  118.     'If you find one then return the record index of the file.
  119.  
  120.     Do
  121.         sTempStr$ = gSortData(i%).FileName                  'I tried this using the array element but it won't work.
  122.         sTempStr$ = LTrim$(RTrim$(sTempStr$)) + Chr$(0) 'So this is a hack to make it work.
  123.         If sTempStr$ = sFileName Then
  124.             GetFileIndex = gSortData(i%).RecNo
  125.             Exit Function
  126.         End If
  127.         i% = i% + 1
  128.     Loop Until i% > glArrayIndex    'Loop until you have checked all the file names.
  129.  
  130.     GetFileIndex = 0                'Didn't find it.
  131. End Function
  132.  
  133. Sub ChgFileName (FileName As String, NewName As String)
  134.     For Index& = 0 To glArrayIndex
  135.         If (gSortData(i&).FileName = FileName) Then
  136.             gSortData(i&).FileName = NewName
  137.             Exit Sub
  138.         End If
  139.     Next Index&
  140. End Sub
  141.  
  142.